home *** CD-ROM | disk | FTP | other *** search
/ User's Choice Windows CD / User's Choice Windows CD (CMS Software)(1993).iso / win_m_p / pwez51.zip / DEMPART2.BAS < prev    next >
BASIC Source File  |  1992-04-01  |  9KB  |  241 lines
  1. '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  2. '!!! THIS MODULE WILL NOT OPERATE AS A STAND-ALONE PROGRAM. IT MUST BE   !!!
  3. '!!! LOADED WITH MODULE DEMO.BAS.  DEMO.BAS MUST BE THE MAIN MODULE....  !!!
  4. '!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  5. DECLARE FUNCTION COL% (C%)
  6. DECLARE SUB CHNGPULL (BAR%, WIND%, ATTR%)
  7. DECLARE SUB CHNGWIND (W%)
  8. DECLARE SUB CLRWIND ()
  9. DECLARE SUB DELWIND (W%)
  10. DECLARE SUB DISKSIZE (DISK%, DISKSZE&, FREESPACE&)
  11. DECLARE SUB DOSOUND ()
  12. DECLARE SUB FINDPATH (PATH$)
  13. DECLARE SUB FINDDIR (PATH$, TYPE$, F%)
  14. DECLARE SUB GETANS (TEXT$, CHOICE$, ANS$, TR%, LC%, ATTR%, BORDER%)
  15. DECLARE SUB GETDISK (DR%)
  16. DECLARE SUB INFOFIXED (FIXED$)
  17. DECLARE SUB INFOLINE (TR%, LC%, WD%, ATTR%)
  18. DECLARE SUB INPTINIT (DTYPE%, ISDOT%, INPTEXIT$)
  19. DECLARE SUB INPTWIND (PROMPT$, CODE$, TR%, LC%, WD%, ATTR%, RESTRICT$, RTRN$, RK%, BRD%)
  20. DECLARE FUNCTION KEYMOUSE% ()
  21. DECLARE SUB LINEW (ROW%, TYP%)
  22. DECLARE SUB MAKEWIND (W%, LABEL$, TR%, LC%, WD%, NR%, ATTR%, BORDER%)
  23. DECLARE FUNCTION MARKED% (RTRN$, START%)
  24. DECLARE SUB MBUTTONS (LBUTTON%, RBUTTON%)
  25. DECLARE SUB MOUSEON (ONFLAF%)
  26. DECLARE SUB MULTINPT (SCRN%, FLD%, EXIT$, AUTOEXIT%, RKEY%, RTRN$())
  27. DECLARE SUB NEWCOLOR (ATTR%)
  28. DECLARE SUB PRESCRL (EXIT$, MARK$, TAGCOL%)
  29. DECLARE SUB PRINTINFO (I$)
  30. DECLARE SUB PRINTW (TEXT$, TR%, LC%)
  31. DECLARE SUB PULLDOWN (INFO$(), A%, B%, EXIT$, RKEY%, ATTR%, HATTR%, BORDER%)
  32. DECLARE SUB RESAVE ()
  33. DECLARE SUB RSTRINFO (DELFLAG%)
  34. DECLARE SUB RSTRINPT (DELFLAG%)
  35. DECLARE SUB RSTRPULL (RSTRMBAR%)
  36. DECLARE SUB RSTRWIND (W%, DELFLAG%)
  37. DECLARE SUB SAVEWIND (W%, TR%, LC%, WD%, NR%)
  38. DECLARE SUB SCRLWIND (LIST$(), INFO$(), TOPLINE$, ENTRIES%, RTRN$, RTRN%, LI%, FC%, RKEY%, HIATTR%)
  39. DECLARE SUB SETDISK (DRIVE%, BADFLAG%)
  40. DECLARE SUB SETINPT (SCRN%, WD%, EXIT$, INPT%(), INPT$(), BACKCOL%)
  41. DECLARE SUB SETPULL (TR%, LC%, WD%, PWIND$())
  42. DECLARE SUB SETWIND (FAST%, SND%, SHADCOL%)
  43. DECLARE FUNCTION WAVAIL% (W%)
  44. DECLARE SUB WINDSTATUS ()
  45. DECLARE SUB SETSCRL (ARROW%, NOHI%, TAGCOLOR%)
  46.  
  47. SUB GETANSDEMO
  48.  
  49.   A% = COL%(80)        ' COLOR/GRAY PURPLE OR B/W
  50.   
  51.   ' MAKE WINDOW 1 AND PRINT IN SAME.
  52.  
  53.   MAKEWIND 1, "@***** Get Answer Window Demonstration *****", 4, 100, 72, 9, A%, 132
  54.   PRINTW "Get answer  windows are used to ask a question and wait for a single", 1, 100
  55.   PRINTW "key response.  They can also be used to pause a program and wait for", 2, 100
  56.   PRINTW "any key to be pressed.  Prompts may be windowed or un-windowed.  The", 3, 100
  57.   PRINTW "area under the prompt or window is restored on exit. If the response", 4, 100
  58.   PRINTW "is displayed, ENTER must be pressed to accept it....", 5, 2
  59.  
  60.   ' GETANS IS NOT WINDOWED AS LAST ARGUMENT ( BORDER ) = 0.  "A", "B", "C"
  61.   ' OR ESC ARE VALID RESPONSES.
  62.   PRINTINFO (" Press A, B or C....")
  63.   ANS$ = ""
  64.   GETANS "[ Press A,B or C to continue.. ]", "ABC", ANS$, 12, 100, 240, 0
  65.   IF ANS$ = CHR$(27) THEN GOTO ENDGET                    ' ESC EXITS
  66.  
  67.   ' GETANS IS WINDOWED AS LAST ARGUMENT ( BORDER ) = 32.  "Y", "N" OR ESC
  68.   ' ARE VALID RESPONSES.
  69.  
  70.   PRINTINFO " Press Y or N...."
  71.   ANS$ = ""
  72.   GOSUB GETANSWER
  73.   IF ANS$ = CHR$(27) THEN GOTO ENDGET
  74.   RSTRWIND 2, 1
  75.  
  76.   PRINTINFO " Press Y or N.  Press ENTER to accept...."
  77.   ANS$ = "N": S$ = " "
  78.   GOSUB GETANSWER
  79.   IF ANS$ = CHR$(27) THEN GOTO ENDGET
  80.  
  81.   ' GETANS IS WINDOWED AS LAST ARGUMENT ( BORDER ) = 32.  ANY KEY EXITS.
  82.   
  83. ENDGET:
  84.   RSTRWIND 2, 1                  ' RESTORE WINDOWS BEFORE EXIT.
  85.   RSTRWIND 1, 1
  86.   EXIT SUB
  87.  
  88. GETANSWER:
  89.   IF A% = 80 THEN B% = 1080 ELSE B% = 15
  90.   GETANS "Are you sure? (Y/N)" + S$, "YN", ANS$, 15, 100, B%, 32
  91.   IF ANS$ = CHR$(27) THEN RETURN
  92.   IF ANS$ = "Y" THEN TEMP$ = "YES" ELSE TEMP$ = "NO"
  93.   MAKEWIND 2, "", 15, 28, 25, 3, A%, 32
  94.   PRINTW "Your reply was: " + TEMP$, 1, 100
  95.   PRINTINFO " Press any key...."
  96.   GETANS "Press any key...", "", "", 20, 100, A% + 128, 32
  97. RETURN
  98.  
  99. END SUB
  100.  
  101. SUB PRINTDEMO
  102.  
  103.    ' MAKE TWO WINDOWS AND PRINT IN EACH ONE.
  104.  
  105.    A% = COL%(112)
  106.    MAKEWIND 1, "@Window #1", 4, 6, 30, 15, A%, 142
  107.    PRINTW "(*** SAMPLE ****)", 11, 100
  108.    B% = 71: IF A% = 15 THEN B% = 112
  109.    MAKEWIND 2, "@Window #2", 4, 45, 30, 15, B%, 142
  110.    PRINTW "(*** SAMPLE ****)", 11, 100
  111.  
  112.    GA$ = "to print in Window #1."
  113.    GOSUB Press
  114.  
  115.    CHNGWIND 1                                 ' MAKE WINDOW 1 ACTIVE.
  116.    PRINTW "  Text can be printed in", 2, 3    ' PRINT IN WINDOW 1.
  117.    PRINTW "multiple windows.  WIND-", 3, 3    '
  118.    PRINTW "OWS R-E-Z  remembers the", 4, 3    '
  119.    PRINTW "color of text printed in", 5, 3    '
  120.    PRINTW "the  window and uses the", 6, 3    '
  121.    PRINTW "same color the next time", 7, 3    '
  122.    PRINTW "text is printed.", 8, 3            '
  123.  
  124.    GA$ = "to print in Window #2."             ' INSTRUCTIONS FOR SUB Press
  125.    GOSUB Press
  126.  
  127.    CHNGWIND 2                                 ' MAKE WINDOW 2 ACTIVE.
  128.    PRINTW "* Text can be centered *", 1, 100  ' PRINT IN WINDOW 2.
  129.    PRINTW "CENTERED TEXT", 2, 100             '
  130.    PRINTW "Single or double lines can", 4, 2  '
  131.    PRINTW "be printed................", 5, 2  '
  132.    LINEW 6, 1                                 ' SINGLE LINE IN ROW 6
  133.    LINEW 7, 2                                 ' DOUBLE LINE IN ROW 7
  134.    PRINTW "A window's interior can be", 8, 2  '
  135.    PRINTW "cleared with any color....", 9, 2  '
  136.  
  137.    GA$ = "to clear Window #1 with a new color."
  138.    GOSUB Press
  139.  
  140.    B% = 95: IF A% = 15 THEN B% = 112          ' FOR A NEW COLOR.
  141.    CHNGWIND 1                                 ' MAKE WINDOW 1 ACTIVE.
  142.    NEWCOLOR B%                                ' CHANGE COLOR FOR WINDOW 1
  143.    CLRWIND                                    ' CLEAR WIND. 1 WITH NEW COLOR
  144.    PRINTW "(* New print-to color *)", 11, 100 ' PRINT WITH NEW COLOR
  145.  
  146.    GA$ = "to print in Window #1 with the new print-to color."
  147.    GOSUB Press
  148.  
  149.    PRINTW "When a window is cleared", 2, 3   ' PRINT IN WIND. 1 WITH NEW COLOR
  150.    PRINTW "The color of text subse-", 3, 3
  151.    PRINTW "quently printed, matches", 4, 3
  152.    PRINTW "the print-to color speci-", 5, 3
  153.    PRINTW "ied when the  window was", 6, 3
  154.    PRINTW "cleared.", 7, 3
  155.  
  156.    GA$ = "to print in Window #1 with another new color."
  157.    GOSUB Press
  158.  
  159.    B% = 92: IF A% = 15 THEN B% = 7
  160.    NEWCOLOR B%                               ' CHANGE COLOR IN WINDOW 1.
  161.    PRINTW "The text's  color can be", 8, 100 ' PRINT IN SAME.
  162.    PRINTW "changed at any time !!!!", 9, 100
  163.  
  164.    GA$ = "....."
  165.    GOSUB Press
  166.  
  167.    RSTRWIND 1, 1: RSTRWIND 2, 1
  168.  
  169.    EXIT SUB
  170.  
  171.  
  172. Press:
  173.   PRINTINFO " DIRECTIONS: Press any key " + GA$     ' PRINT IN INFO-LINE.
  174.   K% = KEYMOUSE%                                    ' WAIT FOR ANY KEY.
  175. RETURN
  176.  
  177.  
  178. END SUB
  179.  
  180. SUB WINDOWDEMO
  181.  
  182.   RSTRINFO 0                       ' RESTORE INFO-LINE & KEEP ACTIVE.
  183.   A% = COL%(71)                    ' RED/GRAY OR B/W
  184.  
  185.   ' MAKE INSTRUCTION WINDOW
  186.   MAKEWIND 20, "@*** Window Demonstration Instructions ***", 2, 100, 72, 10, A%, 111
  187.   PRINTW "Window memory is dynamically allocated and returned to BASIC when a", 1, 3
  188.   PRINTW "window is restored.   Up to 20 windows may be stacked and restored.", 2, 3
  189.   PRINTW "Window memory is outside of BASIC's normal 64K storage area.  Press", 3, 3
  190.   PRINTW "the UP ARROW or move the MOUSE up to create windows at random loca-", 4, 3
  191.   PRINTW "tions.   Press the  DOWN ARROW or move the MOUSE down to remove the", 5, 3
  192.   PRINTW "windows.  Press ESC to exit.   ( NOTE: This is window number 20 )", 6, 3
  193.  
  194.   RANDOMIZE TIMER             ' RESET RANDOM SEED
  195.   WIND% = 0                   ' WINDOW COUNTER
  196.  
  197.  
  198. GETMAKE:
  199.   TR% = INT(11 * RND + 12)               ' GET RANDOM VALUE FOR TOP ROW
  200.   LC% = INT(60 * RND + 3)                ' GET RANDOM VALUE FOR LEFT COLUMN
  201.   NR% = INT((25 - TR% - 3) * RND + 3)    ' GET RANDOM VALUE FOR NUMBER ROWS
  202.   WI% = INT((80 - LC% - 16) * RND + 16)  ' GET RANDOM VALUE FOR WIDTH
  203.   BO% = INT((2) * RND + 100) + 1         ' GET RANDOM VALUE FOR BORDER
  204.   
  205.   ' WAIT FOR ARROW KEY, ESC, OR MOUSE MOVEMENT WITH FUNTION KEYMOUSE.
  206.  
  207.   SELECT CASE KEYMOUSE%
  208.     CASE 27                              ' ESC
  209.       FOR XX% = 19 TO 1 STEP -1
  210.          RSTRWIND XX%, 1                 ' RESTORE ALL WINDOWS.
  211.       NEXT
  212.       RSTRWIND 20, 1
  213.       EXIT SUB                           ' EXIT
  214.  
  215.     CASE 18432                           ' UP ARROW - MAKE WINDOWS
  216.       IF WIND% < 19 THEN
  217.         WIND% = WIND% + 1                ' INCREMENT COUNTER
  218.         A% = WIND% * 16: IF A% = 128 OR A% = 256 THEN A% = 135  ' SET COLORS
  219.         IF A% > 127 THEN A% = A% - 128                          '
  220.         A% = COL(A%)                                            '
  221.         IF A% = 15 THEN IF WIND% / 2 <> INT(WIND% / 2) THEN A% = 112  ' B/W
  222.         IF NR% < 8 OR BO% = 100 THEN BO% = BO% - 100            ' BORDER
  223.         MAKEWIND WIND%, "@Demo Window" + STR$(WIND%), TR%, LC%, WI%, NR%, A%, BO%
  224.       ELSE
  225.         DOSOUND
  226.       END IF
  227.  
  228.     CASE 20480                          ' DOWN ARROW RESTORE WINDOWS.
  229.       IF WIND% > 0 THEN
  230.         RSTRWIND WIND%, 1
  231.         WIND% = WIND% - 1               ' DECREMENT COUNTER
  232.       ELSE
  233.          DOSOUND
  234.       END IF
  235.     CASE ELSE
  236.   END SELECT
  237.   GOTO GETMAKE
  238.  
  239. END SUB
  240.  
  241.